home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / schwazz.exe / SCHWAZZ.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-31  |  10KB  |  270 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X-}
  2. {$M 16384,0,655360}
  3.  
  4. PROGRAM schwazz;
  5.  
  6. {  This Program was started as a test for the VGA256.BGI Graphical }
  7. {    device driver in Turbo Pascal 6.0 and can be used as a screen }
  8. {    saving device, or an entertainment demo.                      }
  9. {                                                                  }
  10. {  The BGI file has been incorporated directly into SCHWAZZ.EXE,   }
  11. {    so, for the RunTime version, no BGI file is necessary.  If    }
  12. {    this source file is being compiled, be sure the CONSTANT      }
  13. {    PATH_TO_VGA256 contains the full path the the VGA256.BGI      }
  14. {    file (including the file name).                               }
  15. {                                                                  }
  16. {  The Device Driver VGA256.BGI was obtained through ShareWare     }
  17. {                                                                  }
  18. {  This source code is the work of Jonathan D. Duncan and was      }
  19. {    completed and Run-Tested on March 20, 1991 using a NorthGate  }
  20. {    386 - 33 Mhz machiene with a Rendition IIe Graphics card and  }
  21. {    NEC MultiSync 4D Monitor.                                     }
  22.  
  23.  
  24. USES
  25.  
  26.   Crt,     { Screen/Keyboard IO-Unit found in Turbo Library }
  27.   Graph;   { Graphical Unit found in Turbo Library          }
  28.  
  29.  
  30. CONST                          { Path to Uses Graphics Driver File          }
  31.  
  32.   Path_To_VGA256 = 'C:\CPG\TP\BGI\VGA256.BGI';
  33.  
  34.  
  35. VAR
  36.  
  37.   boxes, counter,              { Number of Boxes / Counter Variable         }
  38.   x1, x2, y1, y2,              { Top / Bottom  X and Y cordinates for boxes }
  39.   c1, c2, c3      : INTEGER;   { Palette Settings R/G/B                     }
  40.   dirct1,                      { Change Colors for Inside or Outside        }
  41.   dirct2          : BOOLEAN;   { Decrease or Increase RBG Attribute         }
  42.  
  43.  
  44. { -------------------------------------- }
  45.  
  46.  
  47. PROCEDURE VGA256DriverProc; EXTERNAL;
  48.  
  49. {$L vga256.obj}
  50.  
  51.  
  52. { -------------------------------------- }
  53.  
  54.  
  55. { This function checks to insure the presence of VGA hardware }
  56.  
  57. {$F+}                                  { Far Call Mode                      }
  58.  
  59. FUNCTION TestDetect : Integer;
  60.  
  61. VAR
  62.   Gd,Gm : INTEGER;                     { Driver/Mode for Graphics          }
  63.  
  64. BEGIN  { TestDetect }
  65.   DetectGraph(Gd,Gm);                  { Detect hardware                   }
  66.   IF Gd <> VGA THEN
  67.     BEGIN                              { If not Present, Display Message...}
  68.       WriteLn('VGA Monitor and Graphics Card Required');
  69.       Halt(1)                          { ...And Halt Program               }
  70.     END { If/Then }
  71.   ELSE
  72.     TestDetect := 1;                   { Otherwise Setup Detect Number     }
  73. END;   { TestDetect }
  74.  
  75. {$F-}                                  { End Far Call Mode                 }
  76.  
  77.  
  78. { -------------------------------------- }
  79.  
  80.  
  81. { Recognize Driver to Graphics Control Unit }
  82.  
  83. PROCEDURE Install_VGA256;
  84.  
  85. BEGIN  { Install_VGA256 }
  86.   IF (InstallUserDriver('VGA256', @TestDetect) = 0) THEN Halt(1);
  87. END;   { Install_VGA256 }
  88.  
  89.  
  90. { -------------------------------------- }
  91.  
  92.  
  93. { Incorporate BGI driver into EXE file }
  94.  
  95. PROCEDURE Register_VGA256;
  96.  
  97. BEGIN  { Register_VGA256 }
  98.   IF (RegisterBGIdriver(@VGA256DriverProc) < 0) THEN Halt(1); { Halt if Error        }
  99. END;   { Register_VGA256 }
  100.  
  101.  
  102. { -------------------------------------- }
  103.  
  104.  
  105. { Initializes Graphics Mode  }
  106.  
  107. PROCEDURE Initialize;
  108.  
  109. VAR
  110.   Gd,Gm : INTEGER;                     { Driver/Mode Variables for Graphic }
  111.  
  112. BEGIN  { Initialize }
  113.   Gd := Detect;                        { Detect Hardware (Now VGA256)      }
  114.   InitGraph(Gd, Gm, path_to_vga256);   { Initialize Graph Mode             }
  115.   IF GraphResult <> grOk THEN  Halt(1); { Halt Program if Error            }
  116. END;   { Initialize }
  117.  
  118.  
  119. { -------------------------------------- }
  120.  
  121.  
  122. { Display Text on Graphical Screen Centered Vert. and Horiz. }
  123.  
  124. PROCEDURE Write_Text;
  125.  
  126. VAR halfX, quarterY : INTEGER;         { Half/Quarter Screen Width/Height  }
  127.  
  128.   {---->} procedure Put(level : BYTE; message : STRING);
  129.             var width, height : INTEGER; { Starting X/Y pixel              }
  130.             BEGIN  { Put }
  131.               width  := halfX - (TextWidth(message) DIV 2); { Get X pixel  }
  132.               height := level * quarterY;                   { Get Y pixel  }
  133.               OutTextXY(width, height, message);  { Display text message   }
  134.   {<----}   END;   { Put }
  135.  
  136. BEGIN { Write_Text }
  137.   SetColor(0);                         { Set Text Writing Color To Black   }
  138.   halfX := (GetMaxX DIV 2);            { Divide Horiz. Screen in Half      }
  139.   quarterY := (GetMaxY DIV 4);         { Divide Vert. Screen in Quarters   }
  140.   put(1,'S C H W A Z Z E L   1 . 0')   { Write Name Centered               }
  141.   put(2,'March 31, 1992');             { Write Date Centered               }
  142.   put(3,'By Jonathan D. Duncan');      { Write Author Centered             }
  143. END;  { Write_Text }
  144.  
  145.  
  146. { -------------------------------------- }
  147.  
  148.  
  149. { Draws The Rectangles in Different Palette Colors, All appearing Black    }
  150.  
  151. PROCEDURE Draw;
  152.  
  153. BEGIN  { Draw }
  154.   x1 :=       0;  y1 :=       0;       { Set Top Corner Cordinates         }
  155.   x2 := GetMaxX;  y2 := GetMaxY;       { Set Bottom corner Cordinates      }
  156.   boxes := Random(10) + 20;            { Randomly select num boxes (20-30) }
  157.   FOR counter := 1 TO 255 DO           { Sel All colors to Appear as Black }
  158.     SetPalette(counter,0); { For/Do }
  159.   FOR counter := 75 TO (75 + boxes) DO { Draw Boxes in Palette colors 75+  }
  160.     BEGIN
  161.       SetColor(counter);                 { Select Color for Border           }
  162.       SetFillStyle(SolidFill, counter);  { Select Color for Fill             }
  163.       BAR(x1, y1, x2, y2);               { Draw Bar (Rectangle)              }
  164.       Inc(x1,(GetMaxX DIV 2) DIV boxes); { Reset Top X cordinate             }
  165.       x2 := GetMaxX - x1;                { Reset Bottom X cordinate          }
  166.       Inc(y1,(GetMaxY DIV 2) DIV boxes); { Reset Top Y cordinate             }
  167.       y2 := GetMaxY - y1;                { Reset Bottom Y cordinate          }
  168.     END; { For/Do }
  169. END;   { Draw }
  170.  
  171.  
  172. { -------------------------------------- }
  173.  
  174.  
  175. { Switches Physical and Actual Palette Numbers to provide for color change }
  176.  
  177. PROCEDURE Schwazzel(direction1, direction2 : BOOLEAN; RGB : BYTE);
  178.  
  179.   {---->} procedure RGBlevel;          { Change either R, G, or B in RGB   }
  180.           BEGIN { RGBLevel }
  181.             CASE RGB OF                { Which Attribute?                  }
  182.               1 : BEGIN
  183.                     IF direction2 THEN { Increase or Decrease?             }
  184.                       BEGIN
  185.                         Inc(c1);       { Increase | Check for Range Error  }
  186.                         IF (c1 > 2000) THEN c1 := 0;
  187.                       END { If/Then }
  188.                     ELSE
  189.                       BEGIN
  190.                         Dec(c1);       { Decrease | Check for range Error  }
  191.                         IF (c1 < 0) THEN c1 := 2000;
  192.                       END; { If/Then/Else }
  193.                     SetRGBPalette(counter, c1, c2, c3);  { Change Palette }
  194.                   END; { Case/1 }
  195.               2 : BEGIN
  196.                     IF direction2 THEN { Increase or Decrease?             }
  197.                       BEGIN
  198.                         Inc(c2);       { Increase | Check for Range Error  }
  199.                         IF (c2 > 2000) THEN c2 := 0;
  200.                       END { If/Then }
  201.                     ELSE
  202.                       BEGIN
  203.                         Dec(c2);       { Decrease | Check for Range Error  }
  204.                         IF (c2 < 0) THEN c2 := 2000;
  205.                       END; { If/Then/Else }
  206.                     SetRGBPalette(counter, c1, c2, c3);  { Change Palette  }
  207.                   END; { Case/2 }
  208.               3 : BEGIN
  209.                     IF direction2 THEN { Increase or Decrease?             }
  210.                       BEGIN
  211.                         Inc(c3);       { Increase | Check for Range Error  }
  212.                         IF (c3 > 2000) THEN c3 := 0;
  213.